unit dorm.Mappings.Strategies;

interface

uses
  Rtti,
  Generics.Collections,
  superobject,
  dorm.Commons,
  dorm.Mappings;

type
{$RTTI EXPLICIT
    FIELDS([vcPrivate, vcProtected, vcPublic, vcPublished])
    METHODS([vcPrivate, vcProtected, vcPublic, vcPublished])
    PROPERTIES([vcPrivate, vcProtected, vcPublic, vcPublished])}
  IMappingStrategy = interface
    ['{F64D6AF3-C4C2-4098-A241-B3401CE3FB03}']
    procedure GetMapping(const AType: TRttiType; ATable: TMappingTable);
  end;

  ICacheMappingStrategy = interface
    ['{B8C136E4-7C71-4D09-9016-61D2B2271EFE}']
    function GetMapping(const AType: TRttiType): TMappingTable;
    procedure Add(const AMappingStrategy: IMappingStrategy);
  end;

  TMappingTableMerger = class
  private
    function MergeFieldTo(AField: TMappingField; AOutput, AInput: TMappingTable): Boolean;
    function MergeRelation(AInRelation, AOutRelation: TMappingRelation): Boolean;
    function MergeHasOneTo(ARelation: TMappingRelation; AOutput: TMappingTable): Boolean;
    function MergeHasManyTo(ARelation: TMappingRelation; AOutput: TMappingTable): Boolean;
    function MergeBelongsTo(ARelation: TMappingBelongsTo; AOutput: TMappingTable): Boolean;
  public
    procedure Merge(AOutput: TMappingTable; AInput: array of TMappingTable);
  end;

  TCacheMappingStrategy = class(TInterfacedObject, ICacheMappingStrategy)
  private
    FMerger: TMappingTableMerger;
    FMappingStrategies: TList<IMappingStrategy>;
    FMappings: TDictionary<TRttiType, TMappingTable>;
    function GetMapping(const AType: TRttiType): TMappingTable;
    procedure Add(const AMappingStrategy: IMappingStrategy);
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TFileMappingStrategy = class(TInterfacedObject, IMappingStrategy)
  private
    FMapping: ISuperObject;
    procedure GetMapping(const AType: TRttiType; ATable: TMappingTable);
    procedure ParseTable(ATable: TMappingTable; const AJsonTable: ISuperObject);
    procedure ParseIdField(ATable: TMappingTable; const AJsonTable: ISuperObject);
    procedure ParseField(const AField: TMappingField; const AJsonField: ISuperObject);
    procedure ParseHasMany(const AHasMany: TMappingRelation;
      const AJsonRelation: ISuperObject);
    procedure ParseHasOne(const AHasOne: TMappingRelation;
      const AJsonRelation: ISuperObject);
    procedure ParseBelongsTo(const ABelongsTo: TMappingBelongsTo;
      const AJsonRelation: ISuperObject);
  public
    constructor Create(const AJsonMapping: ISuperObject);
  end;

  TAttributesMappingStrategy = class(TInterfacedObject, IMappingStrategy)
  private
    function GetOrCreateField(const ATable: TMappingTable;
      AProp: TRttiProperty): TMappingField;
    procedure ParseTable(const AType: TRttiType; const ATable: TMappingTable);
    procedure ParseField(const AType: TRttiType; const ATable: TMappingTable;
      AProp: TRttiProperty);
    procedure ParseHasOne(const AType: TRttiType; const ATable: TMappingTable;
      AProp: TRttiProperty);
    procedure ParseHasMany(const AType: TRttiType; const ATable: TMappingTable;
      AProp: TRttiProperty);
    procedure ParseBelongsTo(const AType: TRttiType; const ATable: TMappingTable;
      AProp: TRttiProperty);
    procedure GetMapping(const AType: TRttiType; ATable: TMappingTable);
  end;

  TCoCMappingStrategy = class(TInterfacedObject, IMappingStrategy)
  private
    { Checks whether a given type is a candidate for a duck list.
      These conditions must be met:
      Have an Add method with a single argument of any type
      Have a Clear method with no argument
      Have a GetItem method with one argument of type Integer and that
      returns the same type used on Add method
      Have a Count property of type integer. }
    function IsACollectionClass(const AType: TRttiType;
      out ElementType: TRttiType): Boolean;
    function SkipClassPrefix(const ClassName: String): String;
    function GetMethod(const AType: TRttiType; const Name: String;
      const ArgCount: Integer; out Method: TRttiMethod): Boolean;
    procedure ParseTable(const AType: TRttiType; const ATable: TMappingTable);
    procedure ParseField(const AType: TRttiType; const ATable: TMappingTable;
      AProp: TRttiProperty);
    procedure ParseHasOne(const AType: TRttiType; const ATable: TMappingTable;
      AProp: TRttiProperty);
    procedure ParseHasMany(const AType: TRttiType; const ATable: TMappingTable;
      AProp: TRttiProperty);
    procedure GetMapping(const AType: TRttiType; ATable: TMappingTable);
  end;

implementation

uses
  SysUtils,
  StrUtils,
  dorm.Utils,
  Typinfo,
  Classes;

{ TCacheMappingStrategy }

procedure TCacheMappingStrategy.Add(const AMappingStrategy: IMappingStrategy);
begin
  FMappingStrategies.Add(AMappingStrategy);
end;

constructor TCacheMappingStrategy.Create;
begin
  inherited Create;
  FMerger := TMappingTableMerger.Create;
  FMappings := TDictionary<TRttiType, TMappingTable>.Create(128);
  FMappingStrategies := TList<IMappingStrategy>.Create;
end;

destructor TCacheMappingStrategy.Destroy;
var
  _Table: TMappingTable;
begin
  FMerger.Free;
  FMappingStrategies.Clear;
  FMappingStrategies.Free;
  for _Table in FMappings.Values do
    _Table.Free;
  FMappings.Free;
  inherited;
end;

function TCacheMappingStrategy.GetMapping(const AType: TRttiType): TMappingTable;
var
  _MappingTables: array of TMappingTable;
  _i: Integer;
begin
  if not FMappings.TryGetValue(AType, Result) then
  begin
    Result := TMappingTable.Create;
    SetLength(_MappingTables, FMappingStrategies.Count);
    for _i := 0 to High(_MappingTables) do
      _MappingTables[_i] := TMappingTable.Create;
    try
      for _i := 0 to High(_MappingTables) do
        FMappingStrategies[_i].GetMapping(AType, _MappingTables[_i]);
      FMerger.Merge(Result, _MappingTables);
      if Result.TableName = EmptyStr then
        raise Exception.Create(Format('Cound not find mapping to Class %s', [AType.ClassName]));
      FMappings.Add(AType, Result);
    finally
      for _i := 0 to High(_MappingTables) do
        _MappingTables[_i].Free;
    end;
  end;
end;

{ TFileMappingStrategy }

constructor TFileMappingStrategy.Create(const AJsonMapping: ISuperObject);
begin
  inherited Create;
  FMapping := AJsonMapping;
end;

procedure TFileMappingStrategy.GetMapping(const AType: TRttiType; ATable: TMappingTable);
var
  _JSonArray: TSuperArray;
  _JsonTable: ISuperObject;
  _i: Integer;
begin
  _JsonTable := FMapping.O[AType.Name];
  if not Assigned(_JsonTable) then
    Exit;

  ParseTable(ATable, _JsonTable);

  ParseIdField(ATable, _JsonTable);

  _JSonArray := _JsonTable.O['fields'].AsArray;
  if Assigned(_JSonArray) then
  begin
    for _i := 0 to _JSonArray.Length - 1 do
      ParseField(ATable.AddField, _JSonArray[_i]);
  end;

  _JSonArray := _JsonTable.A['has_one'];
  if Assigned(_JSonArray) then
    for _i := 0 to _JSonArray.Length - 1 do
      ParseHasOne(ATable.AddHasOne, _JSonArray[_i]);

  _JSonArray := _JsonTable.A['has_many'];
  if Assigned(_JSonArray) then
    for _i := 0 to _JSonArray.Length - 1 do
      ParseHasMany(ATable.AddHasMany, _JSonArray[_i]);

  _JSonArray := _JsonTable.A['belongs_to'];
  if Assigned(_JSonArray) then
    for _i := 0 to _JSonArray.Length - 1 do
      ParseBelongsTo(ATable.AddBelongsTo, _JSonArray[_i]);
end;

procedure TFileMappingStrategy.ParseTable(ATable: TMappingTable;
  const AJsonTable: ISuperObject);
begin
  ATable.TableName := AJsonTable.S['table'];
  ATable.Package := AJsonTable.S['package'];
end;

procedure TFileMappingStrategy.ParseIdField(ATable: TMappingTable;
  const AJsonTable: ISuperObject);
var
  _IdField: TMappingField;
  _JSonIDField: ISuperObject;
begin
  _JSonIDField := AJsonTable.O['id'];
  if Assigned(_JSonIDField) then
  begin
    _IdField := ATable.AddField;
    ParseField(_IdField, _JSonIDField);
    _IdField.IsPK := True;
  end;
end;

procedure TFileMappingStrategy.ParseField(const AField: TMappingField;
  const AJsonField: ISuperObject);
var
  _IndexType: string;
begin
  AField.Name := AJsonField.S['name'];
  AField.FieldName := AJsonField.S['field'];
  AField.Size := AJsonField.I['size'];
  AField.FieldType := AJsonField.S['field_type'];
  AField.DefaultValue := AJsonField.S['default_value'];
  AField.Precision := AJsonField.I['precision'];
  AField.IndexType := itNone;
  _IndexType := AJsonField.S['index_type'];
  if SameText(_IndexType, 'index') then
    AField.IndexType := itIndex
  else if SameText(_IndexType, 'unique') then
    AField.IndexType := itUnique;
  AField.IsPK := false;
end;

procedure TFileMappingStrategy.ParseHasOne(const AHasOne: TMappingRelation;
  const AJsonRelation: ISuperObject);
begin
  AHasOne.Name := AJsonRelation.S['name'];
  AHasOne.ChildClassName := AJsonRelation.S['class_name'];
  AHasOne.ChildFieldName := AJsonRelation.S['child_field_name'];
  AHasOne.LazyLoad := AJsonRelation.B['lazy_load'];
end;

procedure TFileMappingStrategy.ParseHasMany(const AHasMany: TMappingRelation;
  const AJsonRelation: ISuperObject);
begin
  AHasMany.Name := AJsonRelation.S['name'];
  AHasMany.ChildClassName := AJsonRelation.S['class_name'];
  AHasMany.ChildFieldName := AJsonRelation.S['child_field_name'];
  AHasMany.LazyLoad := AJsonRelation.B['lazy_load'];
end;

procedure TFileMappingStrategy.ParseBelongsTo(const ABelongsTo: TMappingBelongsTo;
  const AJsonRelation: ISuperObject);
begin
  ABelongsTo.Name := AJsonRelation.S['name'];
  ABelongsTo.OwnerClassName := AJsonRelation.S['class_name'];
  ABelongsTo.RefFieldName := AJsonRelation.S['ref_field_name'];
  ABelongsTo.LazyLoad := AJsonRelation.B['lazy_load'];
end;

{ TAttributesMappingStrategy }

procedure TAttributesMappingStrategy.GetMapping(const AType: TRttiType;
  ATable: TMappingTable);
var
  _Property: TRttiProperty;
begin
  ParseTable(AType, ATable);
  for _Property in AType.GetProperties do
  begin
    ParseField(AType, ATable, _Property);
    ParseHasOne(AType, ATable, _Property);
    ParseHasMany(AType, ATable, _Property);
    ParseBelongsTo(AType, ATable, _Property);
  end;
end;

procedure TAttributesMappingStrategy.ParseTable(const AType: TRttiType;
  const ATable: TMappingTable);
var
  _Entity: Entity;
begin
  _Entity := TdormUtils.GetAttribute<Entity>(AType);
  if Assigned(_Entity) then
  begin
    ATable.Package := _Entity.Package;
    ATable.TableName := _Entity.TableName;
  end;
end;

procedure TAttributesMappingStrategy.ParseField(const AType: TRttiType;
  const ATable: TMappingTable; AProp: TRttiProperty);
var
  _Field: TMappingField;
  _Attribute: TCustomAttribute;
begin
  if TdormUtils.HasAttribute<Transient>(AProp) then
    Exit;

  _Attribute := TdormUtils.GetAttribute<Id>(AProp);
  if Assigned(_Attribute) then
  begin
    _Field := GetOrCreateField(ATable, AProp);
    _Field.IsPK := True;
  end;

  _Attribute := TdormUtils.GetAttribute<Column>(AProp);
  if Assigned(_Attribute) then
  begin
    _Field := GetOrCreateField(ATable, AProp);
    with Column(_Attribute) do
    begin
      _Field.FieldName := FieldName;
      _Field.Size := Size;
      _Field.Precision := Precision;
      _Field.DefaultValue := DefaultValue;
    end;
  end;

  _Attribute := TdormUtils.GetAttribute<Size>(AProp);
  if Assigned(_Attribute) then
  begin
    _Field := GetOrCreateField(ATable, AProp);
    with Size(_Attribute) do
    begin
      _Field.Size := ColumnSize;
      if ColumnPrecision <> 0 then
        _Field.Precision := ColumnPrecision
    end;
  end;

  _Attribute := TdormUtils.GetAttribute<DefaultValue>(AProp);
  if Assigned(_Attribute) then
  begin
    _Field := GetOrCreateField(ATable, AProp);
    _Field.DefaultValue := DefaultValue(_Attribute).Value;
  end;

end;

procedure TAttributesMappingStrategy.ParseHasOne(const AType: TRttiType;
  const ATable: TMappingTable; AProp: TRttiProperty);
var
  _Attribute: TCustomAttribute;
  _Relation: TMappingRelation;
  _Lazy: Boolean;
begin
  _Lazy := TdormUtils.HasAttribute<Lazy>(AProp);
  _Attribute := TdormUtils.GetAttribute<HasOne>(AProp);
  if Assigned(_Attribute) then
  begin
    _Relation := ATable.AddHasOne;
    _Relation.Name := AProp.Name;
    _Relation.ChildClassName := AProp.PropertyType.AsInstance.MetaclassType.ClassName;
    _Relation.ChildFieldName := HasOne(_Attribute).ChildPropertyName;
    _Relation.LazyLoad := _Lazy or HasMany(_Attribute).LazyLoad;
  end;
end;

procedure TAttributesMappingStrategy.ParseHasMany(const AType: TRttiType;
  const ATable: TMappingTable; AProp: TRttiProperty);
var
  _Attribute: TCustomAttribute;
  _Relation: TMappingRelation;
  _Lazy: Boolean;
begin
  _Lazy := TdormUtils.HasAttribute<Lazy>(AProp);
  _Attribute := TdormUtils.GetAttribute<HasMany>(AProp);
  if Assigned(_Attribute) then
  begin
    _Relation := ATable.AddHasMany;
    _Relation.Name := AProp.Name;
    _Relation.ChildClassName := AProp.PropertyType.AsInstance.MetaclassType.ClassName;
    _Relation.ChildFieldName := HasMany(_Attribute).ChildPropertyName;
    _Relation.LazyLoad := _Lazy or HasMany(_Attribute).LazyLoad;
  end;
end;

procedure TAttributesMappingStrategy.ParseBelongsTo(const AType: TRttiType;
  const ATable: TMappingTable; AProp: TRttiProperty);
var
  _Attribute: TCustomAttribute;
  _Relation: TMappingBelongsTo;
  _Lazy: Boolean;
begin
  _Lazy := TdormUtils.HasAttribute<Lazy>(AProp);
  _Attribute := TdormUtils.GetAttribute<BelongsTo>(AProp);
  if Assigned(_Attribute) then
  begin
    _Relation := ATable.AddBelongsTo;
    _Relation.Name := AProp.Name;
    _Relation.OwnerClassName := AProp.PropertyType.AsInstance.MetaclassType.ClassName;
    _Relation.RefFieldName := HasOne(_Attribute).ChildPropertyName;
    _Relation.LazyLoad := _Lazy or HasMany(_Attribute).LazyLoad;
  end;
end;

function TAttributesMappingStrategy.GetOrCreateField(
  const ATable: TMappingTable; AProp: TRttiProperty): TMappingField;
begin
  Result := ATable.FindByName(AProp.Name);
  if not Assigned(Result) then
  begin
    Result := ATable.AddField;
    Result.Name := AProp.Name;
    Result.FieldType := TdormUtils.GetFieldType(AProp);
  end;
end;

{ TCoCMappingStrategy }

procedure TCoCMappingStrategy.GetMapping(const AType: TRttiType;
  ATable: TMappingTable);
var
  _Property: TRttiProperty;
begin
  ParseTable(AType, ATable);
  for _Property in AType.GetProperties do
  begin
    ParseHasOne(AType, ATable, _Property);
    ParseHasMany(AType, ATable, _Property);
    // ParseField have to be the last EVER, because it test the
    // if PropertyName there are in relations!!!
    ParseField(AType, ATable, _Property);
  end;
end;

procedure TCoCMappingStrategy.ParseTable(const AType: TRttiType;
  const ATable: TMappingTable);
begin
  ATable.TableName := AnsiUpperCase(SkipClassPrefix(AType.Name));
  ATable.Package := AType.AsInstance.MetaclassType.UnitName;
end;

procedure TCoCMappingStrategy.ParseField(const AType: TRttiType;
  const ATable: TMappingTable; AProp: TRttiProperty);
var
  _Field: TMappingField;
  _FieldType: String;
begin
  if TdormUtils.HasAttribute<Transient>(AProp)
    or Assigned(ATable.FindHasOneByName(AProp.Name))
    or Assigned(ATable.FindHasManyByName(AProp.Name)) then
    Exit;

  _FieldType := TdormUtils.GetFieldType(AProp);
  _Field := ATable.AddField;
  if AnsiUpperCase(AProp.Name) = 'ID' then
    _Field.IsPK := True;
  _Field.Name := AProp.Name;
  _Field.FieldName := AnsiUpperCase(AProp.Name);
  _Field.FieldType := _FieldType;
end;

procedure TCoCMappingStrategy.ParseHasOne(const AType: TRttiType;
  const ATable: TMappingTable; AProp: TRttiProperty);
var
  _Relation: TMappingRelation;
  _PropType: TClass;
  _ElementType: TRttiType;
begin
  if AProp.PropertyType.IsInstance then
  begin
    _PropType := AProp.PropertyType.AsInstance.MetaclassType;
    if (not _PropType.InheritsFrom(TStream))
      and not IsACollectionClass(AProp.PropertyType, _ElementType) then
    begin
      _Relation := ATable.AddHasOne;
      _Relation.Name := AProp.Name;
      _Relation.ChildClassName := _PropType.ClassName;
      _Relation.ChildFieldName := SkipClassPrefix(AType.Name) + 'ID';
      _Relation.LazyLoad := false;
    end;
  end;
end;

procedure TCoCMappingStrategy.ParseHasMany(const AType: TRttiType;
  const ATable: TMappingTable; AProp: TRttiProperty);
var
  _Relation: TMappingRelation;
  _ElementType: TRttiType;
begin
  if AProp.PropertyType.IsInstance then
  begin
    if IsACollectionClass(AProp.PropertyType, _ElementType) then
    begin
      _Relation := ATable.AddHasMany;
      _Relation.Name := AProp.Name;
      _Relation.ChildClassName := _ElementType.Name;
      _Relation.ChildFieldName := SkipClassPrefix(AType.Name) + 'ID';
      _Relation.LazyLoad := false;
    end;
  end;
end;

function TCoCMappingStrategy.GetMethod(const AType: TRttiType; const Name: String;
  const ArgCount: Integer; out Method: TRttiMethod): Boolean;
begin
  Method := AType.GetMethod(Name);
  Result := Assigned(Method) and (Length(Method.GetParameters) = ArgCount);
end;

function TCoCMappingStrategy.IsACollectionClass(
  const AType: TRttiType; out ElementType: TRttiType): Boolean;
var
  _Method: TRttiMethod;
  _Property: TRttiProperty;
begin
  // Check Add
  if not GetMethod(AType, 'Add', 1, _Method) then
    Exit(false);
  ElementType := _Method.GetParameters[0].ParamType;

  // Check Clear
  if not GetMethod(AType, 'Clear', 0, _Method) then
    Exit(false);

  // Check GetItem
  if not GetMethod(AType, 'GetItem', 1, _Method) then
    Exit(false);
  if _Method.GetParameters[0].ParamType.Handle <> TypeInfo(Integer) then
    Exit(false);
  if _Method.ReturnType <> ElementType then
    Exit(false);

  // Check Count
  _Property := AType.GetProperty('Count');
  if not Assigned(_Property) then
    Exit(false);
  if _Property.PropertyType.Handle <> TypeInfo(Integer) then
    Exit(false);

  Result := True;
end;

function TCoCMappingStrategy.SkipClassPrefix(const ClassName: String): String;
begin
  Result := Copy(ClassName, 2);
end;

{ TMappingTableMerger }

procedure TMappingTableMerger.Merge(AOutput: TMappingTable;
  AInput: array of TMappingTable);
var
  _TableToMerge: TMappingTable;
  _FieldToMerge: TMappingField;
  _HasOneToMerge: TMappingRelation;
  _HasManyToMerge: TMappingRelation;
  _BelongsToToMerge: TMappingBelongsTo;
begin
  for _TableToMerge in AInput do
  begin
    if AOutput.TableName = EmptyStr then
      AOutput.TableName := _TableToMerge.TableName;

    if AOutput.Package = EmptyStr then
      AOutput.Package := _TableToMerge.Package;

    for _FieldToMerge in _TableToMerge.Fields do
    begin
      if MergeFieldTo(_FieldToMerge, AOutput, _TableToMerge) then
        Continue;
      AOutput.AddField.Assign(_FieldToMerge);
    end;

    for _HasOneToMerge in _TableToMerge.HasOneList do
    begin
      if MergeHasOneTo(_HasOneToMerge, AOutput) then
        Continue;
      AOutput.AddHasOne.Assign(_HasOneToMerge);
    end;

    for _HasManyToMerge in _TableToMerge.HasManyList do
    begin
      if MergeHasManyTo(_HasManyToMerge, AOutput) then
        Continue;
      AOutput.AddHasMany.Assign(_HasManyToMerge);
    end;

    for _BelongsToToMerge in _TableToMerge.BelongsToList do
    begin
      if MergeBelongsTo(_BelongsToToMerge, AOutput) then
        Continue;
      AOutput.AddBelongsTo.Assign(_BelongsToToMerge);
    end;

  end;
end;

function TMappingTableMerger.MergeFieldTo(AField: TMappingField;
  AOutput, AInput: TMappingTable): Boolean;
var
  _OutPutField: TMappingField;
begin
  _OutPutField := AOutput.FindByName(AField.Name);
  Result := Assigned(_OutPutField);
  if Result then
  begin
    if (_OutPutField.FieldName = EmptyStr)
      and not SameText(_OutPutField.FieldName, AField.FieldName) then
      _OutPutField.FieldName := AField.FieldName;

    if (_OutPutField.FieldType = EmptyStr)
      and not SameText(_OutPutField.FieldType, AField.FieldType) then
      _OutPutField.FieldType := AField.FieldType;

    if (_OutPutField.DefaultValue = EmptyStr)
      and not SameText(_OutPutField.DefaultValue, AField.DefaultValue) then
      _OutPutField.DefaultValue := AField.DefaultValue;

    if (_OutPutField.Size = 0)
      and (_OutPutField.Size <> AField.Size) then
      _OutPutField.Size := AField.Size;

    if (_OutPutField.Precision = 0)
      and (_OutPutField.Precision <> AField.Precision) then
      _OutPutField.Precision := AField.Precision;

    if (_OutPutField.IndexType = itNone)
      and (_OutPutField.IndexType <> AField.IndexType) then
      _OutPutField.IndexType := AField.IndexType;

    if not _OutPutField.IsPK and AField.IsPK then
      _OutPutField.IsPK := AField.IsPK;
  end;
end;

function TMappingTableMerger.MergeRelation(AInRelation, AOutRelation: TMappingRelation): Boolean;
begin
  Result := Assigned(AOutRelation);
  if Result then
  begin
    if (Trim(AOutRelation.ChildClassName) = EmptyStr)
      and not SameText(AOutRelation.ChildClassName, AInRelation.ChildClassName) then
      AOutRelation.ChildClassName := AInRelation.ChildClassName;

    if (Trim(AOutRelation.ChildFieldName) = EmptyStr)
      and not SameText(AOutRelation.ChildFieldName, AInRelation.ChildFieldName) then
      AOutRelation.ChildFieldName := AInRelation.ChildFieldName;

    // for while we will treat the lazy but can be necessary treat the joincolumn field too
    if not AOutRelation.LazyLoad and AInRelation.LazyLoad then
      AOutRelation.LazyLoad := AInRelation.LazyLoad;
  end;
end;

function TMappingTableMerger.MergeHasOneTo(ARelation: TMappingRelation;
  AOutput: TMappingTable): Boolean;
var
  _OutRelation: TMappingRelation;
begin
  _OutRelation := AOutput.FindHasOneByName(ARelation.Name);
  Result := MergeRelation(ARelation, _OutRelation)
end;

function TMappingTableMerger.MergeHasManyTo(ARelation: TMappingRelation;
  AOutput: TMappingTable): Boolean;
var
  _OutRelation: TMappingRelation;
begin
  _OutRelation := AOutput.FindHasManyByName(ARelation.Name);
  Result := MergeRelation(ARelation, _OutRelation)
end;

function TMappingTableMerger.MergeBelongsTo(ARelation: TMappingBelongsTo;
  AOutput: TMappingTable): Boolean;
var
  _OutRelation: TMappingBelongsTo;
begin
  _OutRelation := AOutput.FindBelongsToByName(ARelation.Name);
  Result := Assigned(_OutRelation);
  if Result then
  begin
    if (Trim(_OutRelation.OwnerClassName) = EmptyStr)
      and not SameText(_OutRelation.OwnerClassName, ARelation.OwnerClassName) then
      _OutRelation.OwnerClassName := ARelation.OwnerClassName;

    if (Trim(_OutRelation.RefFieldName) = EmptyStr)
      and not SameText(_OutRelation.RefFieldName, ARelation.RefFieldName) then
      _OutRelation.RefFieldName := ARelation.RefFieldName;

    // for while we will treat the lazy but can be necessary treat the joincolumn field too
    if not _OutRelation.LazyLoad and ARelation.LazyLoad then
      _OutRelation.LazyLoad := ARelation.LazyLoad;
  end;
end;

end.
